home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / amort4.arc / AMORT4.PAS
Pascal/Delphi Source File  |  1986-09-20  |  9KB  |  235 lines
  1. PROGRAM AMORT4;      {By Bob Hunter 12-16-85, Rev. 8-12-86
  2.                       Calculates mo. pmt. and produces amortization schedule
  3.                       for a loan, given the amount, int. rate, and term.
  4.                       Ver.2 includes PRINT option and pmt. dates.
  5.                       Ver.3 includes PAYMENT ESCALATION option.
  6.                       Ver.4 adds LUMP SUM PAYMENTS option, and
  7.                       corrects Binary Math errors.}
  8.  
  9. VAR
  10.   INCHR             : CHAR;
  11.  
  12.   M,M1,P,R,I,IY,AM,
  13.   PY,TM,IM,PM,
  14.   IT,PT,LM   : REAL;
  15.  
  16.   L,Y,Z,Q,
  17.   C,MO,MO1,YR,G,J   : INTEGER;
  18.  
  19.   U,V,PR,CH,INC     : CHAR;
  20.  
  21.   MONTH             : STRING[3];
  22.   MONTHS            : STRING[36];
  23.  
  24.   PRINT,INCR,LUMP   : BOOLEAN;
  25.  
  26.   LP                : ARRAY[1..6] OF REAL;     { LP[J] = LUMP PMTS.}
  27.  
  28.   LZ                : ARRAY[1..6] OF INTEGER;  { LM[J] = MOS. LUMP PMTS. ARE MADE.}
  29.  
  30. LABEL
  31.   GO,PR1,YREND,STDOUT,
  32.   RESULTS,TOTALS,RESUME    ;
  33.  
  34. FUNCTION   EXPN     : REAL;               { Simplifying Amortization Equation }
  35.   BEGIN  EXPN:= EXP(-L*Ln(1+I));END;
  36.  
  37. FUNCTION DENOM      :REAL;                { Simplifying Amortization Equation }
  38.   BEGIN  DENOM:= (1-EXPN)/I;END;
  39.  
  40. FUNCTION NUMER      : REAL;               { Calculating Amortization Equation }
  41.   BEGIN NUMER:=INT((P/DENOM)*100+0.5)/100;END;{while correcting Binary errors }
  42.  
  43. PROCEDURE COMPMON;                                    { String file of months }
  44.   BEGIN
  45.     MONTHS:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
  46.     MONTH:= COPY(MONTHS,3*MO-2,3);
  47.   END;
  48.  
  49. PROCEDURE HEADINGS;
  50.   BEGIN
  51.     WRITELN;
  52.     WRITELN(YR:11,'  PMT.  MONTHLY   PRINCIPAL  INTEREST    REMAINING':50);
  53.     WRITELN('MO.  NO.   PAYMENT   PAYMENT    PAYMENT     PRINCIPAL':61);
  54.     WRITELN('_______________________________________________________':62);WRITELN;
  55.     IF PRINT THEN
  56.     BEGIN
  57.       WRITELN(LST);
  58.       WRITELN(LST,YR:11,'  PMT.  MONTHLY   PRINCIPAL  INTEREST    REMAINING':50);
  59.       WRITELN(LST,'MO.  NO.   PAYMENT   PAYMENT    PAYMENT     PRINCIPAL':61);
  60.       WRITELN(LST,'_______________________________________________________':62);WRITELN(LST);
  61.     END;
  62.   END;
  63.  
  64. PROCEDURE CORRECT;           { Corrects final payment to prevent neg. balance }
  65.   BEGIN PM:=PM+P;M:=PM+IM;P:=0;END;
  66.  
  67. PROCEDURE CORRECT1;     { Corrects final LUMP payment to prevent neg. balance }
  68.   BEGIN PM:=PM+P;LM:=PM+IM;P:=0;END;
  69.  
  70. PROCEDURE LUMPOUT;              { Adjusts normal monthlp pmt. to add LUMP pmt.}
  71.   BEGIN
  72.     IF (PM>P) AND (P<0) THEN CORRECT1;
  73.     IF P<=50 THEN CORRECT1;
  74.     WRITELN('*':6,MONTH:5,Z:5,'  $',LM:7:2,'   $',PM:7:2,'   $',IM:7:2,'   $',P:9:2);
  75.       IF PRINT THEN
  76.         BEGIN
  77.           WRITELN(LST,'*':6,MONTH:5,Z:5,'  $',LM:7:2,'   $',PM:7:2,'   $',IM:7:2,'   $',P:9:2);
  78.         END;
  79.   END;
  80.  
  81. BEGIN { Main Program }
  82.   GO:
  83.   C:=0;M:=0;AM:=0;M1:=0;Y:=0;MO:=0;MO1:=0;TM:=0;IT:=0;PT:=0;G:=0;J:=0;LM:=0;
  84.   CLRSCR;
  85.   WRITE(' Enter PRINCIPAL amount         ==> $ ');READLN(P);WRITELN;
  86.   WRITE('   "   annual INTEREST RATE     ==>   ');READ(R);WRITELN(' %');WRITELN;
  87.   WRITE('   "   NO. of monthly payments  ==>   ');READ(L);WRITELN(' MOS.');WRITELN;
  88.   M:=-1;
  89.   WRITE('   "   MONTHLY PMT. desired     ==> $         else <RET> to COMPUTE');
  90.   GOTOXY(38,11);READLN(M);
  91.   I:=R/1200;
  92.   IF M <=0 THEN
  93.     BEGIN                                        { Calculates monthly payment.}
  94.       M:=NUMER;
  95.       GOTOXY(38,7);WRITE(M:7:2);WRITELN(' (COMPUTED)               ');
  96.     END
  97.   ELSE
  98.     BEGIN
  99.       GOTOXY(38,7);
  100.       WRITE(M:7:2);WRITELN('                          ');
  101.     END;
  102.   WRITELN;
  103.   WRITE(' To CHANGE the MONTHLY PAYMENT enter NEW AMOUNT, else <RET>==> $ ');
  104.   READLN(AM);
  105.   IF AM>0 THEN M:= AM;WRITELN;
  106.   WRITE('PRESS <RET> TO CONTINUE OR `1` TO RETURN TO MENU');
  107.   READ(KBD,CH);
  108.   IF CH='1' THEN GOTO GO;WRITELN;WRITELN;
  109.   WRITE('   "   YEAR loan begins         ==>   ');READLN(YR);WRITELN;
  110.   WRITE('   "   NO. OF MONTH loan begins ==>            (Example Nov. = 11) ');
  111.   GOTOXY(39,15);READ(MO);WRITELN('                                   ');WRITELN;
  112.   COMPMON;
  113.   WRITE(' To INCREASE the MONTHLY PAYMENT DURING TERM enter <Y>, else <RET> ');
  114.   READ(INCHR);WRITELN;
  115.   IF (INCHR='Y') OR (INCHR='y') THEN INCR:=TRUE ELSE INCR:= FALSE;
  116.   IF INCR  THEN
  117.     BEGIN WRITELN;
  118.       WRITE('      Enter AMOUNT of new monthly payment                  ==> $ ');
  119.       READLN(M1);WRITELN;
  120.       WRITE('      Enter NO. OF PMT.(1-',L,') to start new monthly payment ==> ');
  121.       READLN(MO1);
  122.     END;
  123.   WRITELN;
  124.   WRITE(' HOW MANY LUMP SUM PAYMENTS do you wish to make ==>  ');READLN(G);WRITELN;
  125.   IF G<>0 THEN LUMP:=TRUE ELSE LUMP:= FALSE;
  126.   IF LUMP  THEN
  127.     BEGIN
  128.       FOR J:= 1 TO G DO
  129.         BEGIN
  130.           WRITE('      Enter NO. OF SCHEDULED PMT.(1-',L,') to add lump pmt. # ',J,' to==>   ');
  131.           READLN(Q);LZ[J]:=Q;WRITELN;
  132.           WRITE('      Enter AMOUNT of lunp payment # ',J,'                         ==> $ ');
  133.           READLN(LP[J]);WRITELN;
  134.         END;
  135.     END;
  136.   WRITE(' If you want PRINTED OUTPUT, type <P>, else <RET> ' );READLN(PR);WRITELN;
  137.   IF (PR='P') OR (PR='p') THEN PRINT:= TRUE ELSE PRINT := FALSE;
  138.   Y:=L DIV 12;
  139.   IY:=0;PY:=0;
  140.   C:=MO-1;
  141.   CLRSCR;
  142.   WRITELN(' AMORTIZATION OF  $':37,P:1:2,' LOAN');WRITELN;
  143.   WRITELN('    INTEREST RATE ':38,R:1:3,' %');WRITELN;
  144.   WRITELN('       ':19,L,' MONTHLY PAYMENTS @ $ ',M:1:2);WRITELN;
  145.   WRITELN('     STARTING ':35,MONTH,' ',YR);WRITELN;
  146.   IF LUMP  THEN WRITELN(' * Indicates LUMP SUM additional payment made':55);
  147.   IF PRINT THEN
  148.     BEGIN
  149.       WRITELN(LST,' AMORTIZATION OF  $':37,P:1:2,' LOAN');WRITELN(LST);
  150.       WRITELN(LST,'    INTEREST RATE ':38,R:1:3,' %');WRITELN(LST);
  151.       WRITELN(LST,'       ':19,L,' MONTHLY PAYMENTS @ $ ',M:1:2);WRITELN(LST);
  152.       WRITELN(LST,'     STARTING ':35,MONTH,' ',YR);WRITELN(LST);
  153.       IF LUMP  THEN WRITELN(LST,' * Indicates LUMP SUM additional payment made':55);
  154.       WRITELN(LST);
  155.     END;
  156.   HEADINGS;
  157.   FOR Z:=1 TO L+2 DO
  158.     BEGIN
  159.       WHILE C<12 DO
  160.         BEGIN RESULTS:
  161.           IF P=0 THEN GOTO YREND;
  162.           IF ((INCR=TRUE) AND (Z >= MO1)) THEN M:=M1;    {INCREASES MONTHLY PMT. AT MO. REQUESTED}
  163.           IM:=P*I;
  164.           IM:=INT(IM*100+0.5)/100;       { Correct for binary math.}
  165.           PM:=M-IM;P:=P-PM;
  166.           IF (PM>P) AND (P<0) THEN CORRECT;
  167.           IF P<=50 THEN CORRECT;
  168.           IF LUMP  THEN
  169.             BEGIN
  170.               FOR J:=1 TO G DO
  171.                 BEGIN
  172.                   IF Z= LZ[J] THEN
  173.                     BEGIN
  174.                       P:=P-LP[J];PM:=PM+LP[J];LM:=M+LP[J];TM:=TM+LP[J];
  175.                       LUMPOUT;GOTO RESUME;
  176.                     END;
  177.                 END;
  178.             END;
  179.           STDOUT:
  180.             BEGIN
  181.               WRITELN(MONTH:11,Z:5,'  $',M:7:2,'   $',PM:7:2,'   $',IM:7:2,'   $',P:9:2);
  182.               IF PRINT THEN
  183.                 BEGIN
  184.                   WRITELN(LST,MONTH:11,Z:5,'  $',M:7:2,'   $',PM:7:2,'   $',IM:7:2,'   $',P:9:2);
  185.                 END;
  186.             END;
  187.           RESUME:
  188.           IY:=IY+IM;PY:=PY+PM;
  189.           TM:=TM+M;IT:=IT+IM;PT:=PT+PM;C:=C+1;Z:=Z+1;
  190.           MO:=MO+1;IF MO>12 THEN MO:=1;
  191.           COMPMON;
  192.         END;
  193.       YREND:
  194.         IF Z MOD 12>0 THEN YR:=YR+1;WRITELN;
  195.         WRITELN('TOTAL PAID IN ':22,YR-1,': $',PY:8:2,'  $',IY:8:2);WRITELN;
  196.         IF PRINT THEN
  197.           BEGIN WRITELN(LST);
  198.             WRITELN(LST,'TOTAL PAID IN ':22,YR-1,': $',PY:8:2,'  $',IY:8:2);WRITELN(LST);
  199.           END;
  200.         WRITELN;
  201.         IY:=0;PY:=0;
  202.         IF P=0 THEN GOTO TOTALS;
  203.         WRITE('PRESS <RET> TO CONTINUE OR `1` TO RETURN TO MENU');
  204.         READ(KBD,CH);
  205.         IF CH='1' THEN GOTO GO
  206.         ELSE
  207.           BEGIN WRITELN;WRITELN;
  208.             CLRSCR;
  209.             C:=0;Z:=Z-1;  {TO ACCOUNT FOR Z INCREMENTING AT FOR STATEMENT}
  210.             HEADINGS;
  211.           END;
  212.     END;
  213.   BEGIN TOTALS:
  214.     WRITELN;
  215.     WRITELN('*** LOAN TOTALS: ***':44);WRITELN;
  216.     WRITELN('          TOTAL     PRINCIPAL   INTEREST':49);
  217.     WRITELN('         ________________________________':50);WRITELN;
  218.     WRITELN('     $':17,TM:9:2,'  $',PT:8:2,' $',IT:9:2);
  219.     IF PRINT THEN
  220.       BEGIN
  221.         WRITELN(LST);
  222.         WRITELN(LST,'*** LOAN TOTALS: ***':44);WRITELN(LST);
  223.         WRITELN(LST,'          TOTAL     PRINCIPAL   INTEREST':49);
  224.         WRITELN(LST,'         ________________________________':50);WRITELN(LST);
  225.         WRITELN(LST,'     $':17,TM:9:2,'  $',PT:8:2,' $',IT:9:2);
  226.       END;
  227.     HALT;
  228.   END;
  229. END.
  230. ***
  231. INDEX OF VARIABLES:
  232.  
  233. PY=PRIN. FOR YR.
  234. IY=INT. FOR YR
  235.